home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1995 November / Macworld Nov ’95.toast / Developers / Selection ƒ 2.5 / tescrollV < prev    next >
Encoding:
Text File  |  1994-11-06  |  2.7 KB  |  139 lines  |  [TEXT/MSET]
  1.  
  2. \ A tescrollV is a textbox with a vertical scrollbar
  3.  
  4. :class textvScroll super{ vscrollBar }
  5.  
  6. \ ScrollOnce: is a late-bound call in the superclass, so this is all we need
  7.  
  8. :m ScrollOnce:
  9.     0 ( dh)
  10.     get: controlWas  get: self -  get: pixDelta *  ( dv)
  11.     pack
  12.     handle: [ get: scrollObject ]    \ will be the TEHandle, of course
  13.     call TEPinScroll
  14.     get: self  put: controlWas
  15.     ;m
  16.  
  17. ;class
  18.  
  19.  
  20. :class tescrollV super{ tebox nullSelect OwnerObj }
  21.     textvScroll tvscroll
  22.  
  23. :m classinit:
  24.     10 put: #chars    \ #characters per line
  25.     5 put: #lines    \ #lines to display
  26.     ;m
  27.  
  28. \ CalcVScrollValue: is useful for calculating the new value of a vertical scrollbar
  29. \ in a scrolling TErecord after the toolbox has automatically scrolled the
  30. \ text for us (it is then up to us to figure out the new scrollbar settings).
  31.  
  32. :m CalcVScrollValue:  ( -- n )
  33.     ptr: super 8 + ( dest) gettopy: rect
  34.     ptr: super ( view) gettopy: rect  -
  35.     lineHeight: super / ;m
  36.  
  37.  
  38. \ (new): must only be done at new: time since we are storing an ivar address
  39. \ in our scrollbar !!
  40. :m (new):    
  41.     view: super     { l t r b -- }
  42.     r ( x) t 1- ( y)  b t - 2 + ( len ) init: tvscroll    \ note, storing addr of tescrollV in control!
  43.  
  44.     lineheight: super    ( pixdelta to scroll) \ te, must be new:
  45.     get: #lines 1- ( number of lines for a page scroll)
  46.         setscrollValues: tvscroll    \ should use font info for this instead?
  47.     0 0 putrange: tvscroll        \ we are assuming there is no text at new time
  48.     
  49.     l t r b setscrollrect: tvscroll
  50.     ;m
  51.  
  52. :m new: { wptr -- }    
  53.     wptr new: super    \ here, view and dest will be set same as outline
  54.     (new): self    \ must only be done at new: time
  55.     true makeint handle: super call TEAutoView    \ enable automatic scrolling
  56.     wptr new: tvscroll
  57.     self scrolledBy: tvscroll
  58.     ;m
  59.  
  60. :m activate:
  61.     activate: super
  62.     activate: tvscroll ;m
  63.     
  64. :m deactivate:
  65.     deactivate: super
  66.     deactivate: tvscroll ;m
  67.  
  68. :m move:  { dx dy -- }
  69.     dx dy move: super
  70.     dx dy move: tvscroll ;m
  71.  
  72. :m moveto:  { x y -- }
  73.     x y moveto: super
  74.     x y moveto: tvscroll ;m
  75.  
  76. :m release:
  77.     release: super
  78.     release: tvscroll
  79.     ;m
  80.  
  81. :m hit?:    ( -- b )
  82.     view: super put: temprect 16 0 stretch: temprect
  83.     where: theMouse
  84.     temprect PtinRect
  85.     ;m
  86.  
  87. :m setControl:
  88.     0 ( min) #lines: super ( max)
  89.     get: #lines -  0 max
  90.     putrange: tvscroll
  91.     CalcVScrollValue: self   set: tvscroll
  92.     draw: tvscroll
  93.     ;m
  94.  
  95. :m click:
  96.     hit?: tvscroll
  97.         IF    click: tvscroll
  98.             setControl: [self] exit
  99.         THEN
  100.     hit?: super
  101.         IF    click: super
  102.             setControl: [self]
  103.         THEN
  104.         ;m
  105.  
  106. :m key:
  107.     key: super
  108.     setControl: [self]
  109.     ;m
  110.  
  111. :m draw:
  112.     draw: super
  113.     draw: tvscroll
  114.     ;m
  115.  
  116. :m cut:
  117.     cut: super setControl: [self] ;m
  118.  
  119. :m paste:
  120.     paste: super setControl: [self] ;m
  121.  
  122. :m clear:
  123.     clear: super setControl: [self] ;m
  124.  
  125. :m put:  ( addr len -- )
  126.     put: super setControl: [self] ;m
  127.     
  128. ;class
  129.  
  130. endload
  131.  
  132. *** EXAMPLE USE
  133.  
  134. selwindow w
  135. test: w
  136.  
  137. tescrollV tv
  138. tv add: w
  139.